home *** CD-ROM | disk | FTP | other *** search
- UNIT AE3 ;
-
- {$R-}
- {$B-}
- {$I-}
- {$S+}
- {$V-}
-
- INTERFACE
-
- USES Crt, Dos, AE0, AE1, AE2 ;
-
- PROCEDURE EnterString (VAR S : STRING; Hist : HistPtr ; Prompt : STRING ;
- MaxLength : BYTE ; CapsLock : BOOLEAN ; AlphaOnly : BOOLEAN) ;
- PROCEDURE EnterWord (VAR W : WORD ; Prompt : STRING ; MinValue, MaxValue : WORD) ;
- PROCEDURE SaveFile (Wsnr : BYTE) ;
- FUNCTION GetKeyNr : WORD ;
- FUNCTION Answer (question : STRING) : BOOLEAN ;
- FUNCTION Choose (Choices, Prompt : STRING) : CHAR ;
- PROCEDURE DisplayInfo ;
-
- IMPLEMENTATION
-
- {-----------------------------------------------------------------------------}
- { Prompts the user to enter a string on the bottom line of the screen, with }
- { maximum length <MaxLength>. Parameters CapsLock and AlphaOnly instruct the }
- { procedure to convert lower case characters to upper case, and to accept }
- { only alphanumeric characters, respectively. Pressing Escape will restore }
- { the old value of S. }
- {-----------------------------------------------------------------------------}
-
- PROCEDURE EnterString (VAR S : STRING; Hist : HistPtr ; Prompt : STRING ;
- MaxLength : BYTE ; CapsLock : BOOLEAN ; AlphaOnly : BOOLEAN) ;
-
- VAR OldS : STRING ;
- OldXpos, OldYpos : BYTE ;
- OldCursorType : BYTE ;
- i,j : BYTE ;
- Key : WORD ;
- Start, VisibleLength : BYTE ;
- ShowOnScreen : BOOLEAN ;
-
- BEGIN
- OldXpos := WHEREX ;
- OldYpos := WHEREY ;
- OldCursorType := GetCursor ;
- SetCursor (Config.Setup.CursorType) ;
- OldS := S ;
- { translate CR/LF pairs in string to CRLFalias ('Ÿ') }
- REPEAT i := POS (CR + LF, S) ;
- IF i > 0
- THEN BEGIN
- S [i] := CRLFalias [1] ;
- S [i + 1] := CRLFalias [2] ;
- END ;
- UNTIL i = 0 ;
- Start := 1 ;
- VisibleLength := ColsOnScreen - LENGTH (Prompt) - 1 ;
- ShowOnScreen := (MacroStackPointer = Inactive) ;
- IF ShowOnScreen
- THEN BEGIN
- SetBottomLine (Prompt + COPY (S, Start, VisibleLength) ) ;
- CursorTo (LENGTH (Prompt) + 1, 25) ;
- END ;
- Key := GetKeyNr ;
- IF (Key < 256) OR (Key = CtrlReturnKey)
- THEN S := '' ;
- i := 1 ;
- REPEAT CASE Key OF
- 264 {Bksp} : IF i > 1
- THEN BEGIN
- IF COPY (S, i - 1, 2) = CRLFalias
- THEN BEGIN
- DEC (i, 2) ;
- DELETE (S, i, 2) ;
- END
- ELSE BEGIN
- DEC (i) ;
- DELETE (S, i, 1) ;
- END ;
- END
- ELSE WarningBeep ;
- 32..126 : IF LENGTH (S) < MaxLength
- THEN BEGIN
- IF CapsLock
- THEN INSERT (UPCASE (CHR (Key) ), S, i)
- ELSE INSERT (CHR (Key), S, i) ;
- INC (i) ;
- END
- ELSE WarningBeep ;
- 1..31,
- 127..255 : IF (NOT AlphaOnly) AND (LENGTH (S) < MaxLength)
- THEN BEGIN
- INSERT (CHR (Key), S, i) ;
- INC (i) ;
- END
- ELSE WarningBeep ;
- CtrlReturnKey : IF (NOT AlphaOnly) AND (LENGTH (S) < (MaxLength - 1) )
- THEN BEGIN
- INSERT (CRLFalias, S, i) ;
- INC (i, 2)
- END
- ELSE WarningBeep ;
- 327 {Home} : i := 1 ;
- 335 {End} : i := LENGTH (S) + 1 ;
- 331 {Left} : IF i > 1
- THEN BEGIN
- IF (COPY (S, i - 2, 2) = CRLFalias) AND (i > 2)
- THEN DEC (i, 2)
- ELSE DEC (i) ;
- END ;
- 333 {Right} : IF i <= LENGTH (S)
- THEN BEGIN
- IF COPY (S, i, 2) = CRLFalias
- THEN INC (i, 2)
- ELSE INC (i) ;
- END ;
- 371 {^Left} : BEGIN
- IF i > 1
- THEN BEGIN
- REPEAT DEC (i) ;
- UNTIL (NOT (S [i] IN WordSeparators) ) OR
- (i = 1) ;
- WHILE (NOT (S [i - 1] IN WordSeparators) ) AND
- (i > 1)
- DO DEC (i) ;
- END ;
- END ;
- 372 { ^Right} : BEGIN
- WHILE (NOT (S [i] IN WordSeparators) ) AND
- (i <= LENGTH (S) )
- DO INC (i) ;
- WHILE (S [i] IN WordSeparators) AND
- (i <= LENGTH (S) )
- DO INC (i) ;
- END ;
- 339 {Del} : IF COPY (S, i, 2) = CRLFalias
- THEN DELETE (S, i, 2)
- ELSE DELETE (S, i, 1) ;
- 273 {Alt-W} : BEGIN
- j := i ;
- WHILE (NOT (S [j] IN WordSeparators) ) AND
- (j <= LENGTH (S) )
- DO INC (j) ;
- WHILE (S [j] IN WordSeparators) AND
- (j <= LENGTH (S) )
- DO INC (j) ;
- DELETE (S, i, j-i) ;
- END ;
- 294 {Alt-L} : BEGIN
- S := '' ;
- i := 1 ;
- END ;
- 328 { up },
- 336 { down } : IF Hist = NIL
- THEN WarningBeep
- ELSE BEGIN
- IF Hist^.Len > 0
- THEN BEGIN
- IF Key = 328 { up }
- THEN S := PrevHistLine (Hist)
- ELSE S := NextHistLine (Hist) ;
- i := 1 ;
- END ;
- END ;
- 338 {Ins} : Config.Setup.Insertmode :=
- NOT Config.Setup.Insertmode ;
- END ; { of case }
- IF i > (Start + VisibleLength)
- THEN Start := i - VisibleLength
- ELSE BEGIN
- IF Start > i
- THEN Start := i ;
- END ;
- IF ShowOnScreen
- THEN BEGIN
- SetBottomLine (Prompt + COPY (S, Start, VisibleLength) ) ;
- CursorTo (LENGTH (Prompt) + 1 + i - Start, 25) ;
- END ;
- IF (Key <> ReturnKey) AND (Key <> EscapeKey) THEN Key := GetKeyNr ;
- UNTIL (Key = ReturnKey) OR (Key = EscapeKey) ;
- EscPressed := (Key = EscapeKey) ;
- IF EscPressed
- THEN BEGIN
- S := OldS ;
- IF Hist <> NIL THEN Hist^.CurLine := 0 ;
- END
- ELSE BEGIN
- IF (Hist <> NIL)
- THEN IF (LENGTH(S) > 0)
- THEN AddToHistory (Hist, S)
- ELSE Hist^.CurLine := 0 ;
- { replace CRLFalias in string with CR/LF pairs }
- REPEAT i := POS (CRLFalias, S) ;
- IF i > 0
- THEN BEGIN
- S [i] := CR ;
- S [i + 1] := LF ;
- END ;
- UNTIL i = 0 ;
- END ;
- IF ShowOnScreen
- THEN SetBottomLine ('') ;
- CursorTo (OldXpos, OldYpos) ;
- SetCursor (OldCursorType) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Prompts the user to enter a numeric value. If a string is entered that can }
- { not be interpreted as a numeric value, or if the value is not within the }
- { limits MinValue..MaxValue, an error is given and the procedure is repeated. }
- { Pressing Escape will restore the old value of W. }
- {-----------------------------------------------------------------------------}
-
- PROCEDURE EnterWord (VAR W : WORD ; Prompt : STRING ; MinValue, MaxValue : WORD) ;
-
- VAR S : STRING ;
- Code : INTEGER ;
- OK : BOOLEAN ;
-
- BEGIN
- STR (W, S) ;
- REPEAT EnterString (S, NIL, Prompt, 5, FALSE, TRUE) ;
- VAL (S, W, Code) ;
- IF Code <> 0
- THEN ErrorMessage (20)
- ELSE BEGIN
- IF W < MinValue
- THEN ErrorMessage (21) ;
- IF W > MaxValue
- THEN ErrorMessage (22) ;
- END ;
- UNTIL (Code = 0) AND (W >= MinValue) AND (W <= MaxValue) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Saves the file in workspace <Wsnr> to disk. If there is no name yet, }
- { the user is prompted for one. }
- {-----------------------------------------------------------------------------}
-
- PROCEDURE SaveFile (Wsnr : BYTE) ;
-
- VAR F : FILE ;
- Counter : WORD ;
- DotPos : BYTE ;
- BAKfilename : PathStr ;
- OldStatusLine : ScreenBlockPtr ;
-
- BEGIN
- { save contents of statusline }
- SaveArea (1, LinesOnScreen, ColsOnScreen, LinesOnScreen, OldStatusLine) ;
- { make copy of current workspace equal to original }
- IF Wsnr = CurrentWsnr
- THEN Workspace [CurrentWsnr] := CurrentWs ;
- WITH Workspace [Wsnr] DO
- BEGIN
- EscPressed := FALSE ;
- IF LENGTH (Name) = 0
- THEN BEGIN
- EnterString (Name, NIL, 'Saving file. Filename: ', 79, TRUE, TRUE) ;
- IF LENGTH (Name) = 0
- THEN EscPressed := TRUE
- ELSE IF Wildcarded (Name)
- THEN BEGIN
- ErrorMessage (16) ;
- EscPressed := TRUE ;
- END
- ELSE Name := FExpand (Name) ;
- END ;
- IF NOT EscPressed
- THEN BEGIN
- Message ('Saving file ' + Name) ;
- IF (Config.Setup.MakeBAKfile) AND (Exists (Name) )
- THEN BEGIN
- { determine name of backup file }
- DotPos := POS ('.', Name) ;
- IF DotPos = 0
- THEN BAKfilename := Name + '.BAK'
- ELSE BAKfilename := COPY (Name, 1, DotPos) + 'BAK' ;
- { delete old backup file if present }
- IF Exists (BAKfilename)
- THEN BEGIN
- ASSIGN (F, BAKfilename) ;
- ERASE (F) ;
- END ;
- { rename file to backup file }
- ASSIGN (F, Name) ;
- RENAME (F, BAKfilename) ;
- END ;
- ASSIGN (F, Name) ;
- REWRITE (F, BufferSize) ;
- CheckDiskError ;
- IF DiskError = 0
- THEN BEGIN
- { save contents of buffer to file }
- BLOCKWRITE (F, Buffer^, 1) ;
- CheckDiskError ;
- CLOSE (F) ;
- IF DiskError = 0
- THEN { save was successful }
- ChangesMade := FALSE ;
- END ;
- GETTIME (LastTimeSaved [1], LastTimeSaved [2],
- LastTimeSaved [3], LastTimeSaved [4]) ;
- MessageRead := TRUE ;
- END ;
- END ; { of with }
- { restore status line }
- RestoreArea (1, LinesOnScreen, ColsOnScreen, LinesOnScreen, OldStatusLine) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Displays a table with the entire IBM character set, from which the user }
- { can then make a choice, using the cursor and Return keys. Pressing Escape }
- { will return a value of 279. Cursor shape and position and screen contents }
- { are saved, and restored on exit. }
- {-----------------------------------------------------------------------------}
-
- FUNCTION GetKeyFromTable : WORD ;
-
- VAR OldAttr, OldXpos, OldYpos, OldCursorType, KeyNr, Counter : BYTE ;
- OldDisplayContents : ScreenBlockPtr ;
- ScrEl : ScreenElement ;
- SelectKey : WORD ;
-
- BEGIN
- OldXpos := WHEREX ;
- OldYpos := WHEREY ;
- OldCursorType := GetCursor ;
- OldAttr := TextAttr ;
- TextAttr := ScreenColorArray [Config.Setup.ScreenColors].NormAttr ;
- SaveArea (7, 2, 74, 21, OldDisplayContents) ;
- SetCursor (Inactive) ;
- { put empty table on screen }
- PutFrame (7, 2, 74, 21, Quasi3DFrame) ;
- ClearArea (8, 3, 73, 20) ;
- ScrEl.Attribute := TextAttr ;
- { fill table }
- FOR Counter := 0 TO 255 DO
- BEGIN
- ScrEl.Contents := CHR (Counter) ;
- DisplayPtr^ [4 + (Counter DIV 32) * 2, 9 + (Counter MOD 32) * 2] := WORD (ScrEl) ;
- END ;
- KeyNr := 0 ;
- REPEAT GOTOXY (9, 20) ; WRITE ('ASCII value: ', KeyNr : 3) ;
- { show selected character }
- WITH ScreenColorArray [Config.Setup.ScreenColors] DO
- ScrEl.Attribute := BlockAttr ;
- ScrEl.Contents := CHR (KeyNr) ;
- DisplayPtr^ [4 + (KeyNr DIV 32) * 2, 9 + (KeyNr MOD 32) * 2] := WORD (ScrEl) ;
- { read a key from the keyboard }
- SelectKey := ReadKeyNr ;
- { hide previously selected character }
- ScrEl.Attribute := TextAttr ;
- ScrEl.Contents := CHR (KeyNr) ;
- DisplayPtr^ [4 + (KeyNr DIV 32) * 2, 9 + (KeyNr MOD 32) * 2] := WORD (ScrEl) ;
- CASE SelectKey OF
- 328 : { up } DEC (KeyNr, 32) ;
- 336 : { down } INC (KeyNr, 32) ;
- 331 : { left } DEC (KeyNr) ;
- 333 : { right } INC (KeyNr) ;
- 371 : { ^left } DEC (KeyNr, 8) ;
- 372 : { ^right } INC (KeyNr, 8) ;
- ReturnKey : ;
- EscapeKey : ;
- ELSE WarningBeep ;
- END ; { of case }
- ScrEl.Attribute := TextAttr ;
- ScrEl.Contents := CHR (KeyNr) ;
- DisplayPtr^ [4 + (KeyNr DIV 32) * 2, 9 + (KeyNr MOD 32) * 2] := WORD (ScrEl) ;
- UNTIL (SelectKey = ReturnKey) OR (SelectKey = EscapeKey) ;
- RestoreArea (7, 2, 74, 21, OldDisplayContents) ;
- TextAttr := OldAttr ;
- GOTOXY (OldXpos, OldYpos) ;
- SetCursor (OldCursorType) ;
- IF SelectKey = EscapeKey
- THEN GetKeyFromTable := 279 { alt-I }
- ELSE GetKeyFromTable := KeyNr ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Displays help screens containing the key definitions }
- { Cursor shape and position and screen contents are saved, and }
- { restored on exit. }
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DisplayHelp ;
-
- VAR OldDisplayContents : ScreenBlockPtr ;
- OldXpos, OldYpos, OldCursorType : BYTE ;
-
- BEGIN
- OldXpos := WHEREX ;
- OldYpos := WHEREY ;
- OldCursorType := GetCursor ;
- SetCursor (Inactive) ;
- SaveArea (1, 1, ColsOnScreen, LinesOnScreen, OldDisplayContents) ;
- ClearArea (1, 1, ColsOnScreen, NrOfTextLines) ;
- WRITELN (' ⁄ƒƒƒƒƒƒƒƒƒƒƒƒƒ¬ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒø') ;
- WRITELN (' ≥ NORMAL KEY ≥ SHIFT+KEY ≥') ;
- WRITELN ('⁄ƒƒƒƒƒ≈ƒƒƒƒƒƒƒƒƒƒƒƒƒ≈ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ¥') ;
- WRITELN ('≥ F1 ≥ HELP ≥ SETUP ≥') ;
- WRITELN ('≥ F2 ≥ SAVE FILE ≥ WRITE TO FILE ≥') ;
- WRITELN ('≥ F3 ≥ LOAD FILE ≥ INSERT FILE ≥') ;
- WRITELN ('≥ F4 ≥ FIND * ≥ FIND & REPLACE * ≥') ;
- WRITELN ('≥ F5 ≥ PUT MARK ≥ ERASE MARK ≥') ;
- WRITELN ('≥ F6 ≥ CUT BLOCK ≥ DELETE BLOCK ≥') ;
- WRITELN ('≥ F7 ≥ COPY BLOCK ≥ COMPARE BLOCK TO PASTE BUFFER ≥') ;
- WRITELN ('≥ F8 ≥ PASTE BLOCK ≥ PRINT BLOCK ≥') ;
- WRITELN ('≥ F9 ≥ NEXT WINDOW ≥ PREVIOUS WINDOW ≥') ;
- WRITELN ('≥ F10 ≥ DOS COMMAND ≥ ≥') ;
- WRITELN ('¿ƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒŸ') ;
- WRITELN ;
- WRITELN (' *: FIND/REPLACE OPTIONS') ;
- WRITELN ;
- WRITELN (' I = IGNORE CASE') ;
- WRITELN (' N = NO QUERY DURING REPLACE') ;
- WRITELN (' R = REVERSE DIRECTION') ;
- WRITELN (' W = SEARCH FOR WHOLE WORDS') ;
- Pause ;
- IF NOT EscPressed
- THEN
- BEGIN
- ClearArea (1, 1, ColsOnScreen, NrOfTextLines) ;
- WRITELN ('⁄ƒƒƒƒƒƒƒƒƒ¬ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒø') ;
- WRITELN ('≥ ALT+KEY ≥ ACTION ≥') ;
- WRITELN ('√ƒƒƒƒƒƒƒƒƒ≈ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ¥') ;
- WRITELN ('≥ 1..9,0 ≥ REPLAY MACRO NR 1..9,10 ≥') ;
- WRITELN ('≥ A ≥ SWITCH TO WINDOW A ≥') ;
- WRITELN ('≥ C ≥ CENTER LINE ≥') ;
- WRITELN ('≥ D ≥ DEFINE KEYBOARD MACRO ≥') ;
- WRITELN ('≥ E ≥ EJECT PRINTER PAGE ≥') ;
- WRITELN ('≥ F ≥ FORMAT PARAGRAPH ≥') ;
- WRITELN ('≥ G ≥ GET SAVED POSITION ≥') ;
- WRITELN ('≥ I ≥ IBM CHAR.SET (ASCII TABLE) ≥') ;
- WRITELN ('≥ J ≥ JUSTIFY LINE TO THE RIGHT ≥') ;
- WRITELN ('≥ L ≥ DELETE LINE ≥') ;
- WRITELN ('≥ M ≥ MATCH BRACKETS ({[<>]}) ≥') ;
- WRITELN ('≥ N ≥ NEW (CLEAR BUFFER) ≥') ;
- WRITELN ('≥ P ≥ PRINT ENTIRE FILE ≥') ;
- WRITELN ('≥ Q ≥ DISPLAY EDITOR STATUS ≥') ;
- WRITELN ('≥ R ≥ REPEAT LAST FIND/REPLACE ≥') ;
- WRITELN ('≥ S ≥ SAVE POSITION ≥') ;
- WRITELN ('≥ T ≥ TOGGLE UPPER/LOWERCASE ≥') ;
- WRITELN ('≥ U ≥ CONVERT TO UPPERCASE ≥') ;
- WRITELN ('≥ W ≥ DELETE WORD FORWARD ≥') ;
- WRITELN ('≥ X ≥ EXIT PROGRAM ≥') ;
- WRITELN ('¿ƒƒƒƒƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒŸ') ;
- Pause ;
- END ; { of if }
- IF NOT EscPressed
- THEN
- BEGIN
- ClearArea (1, 1, ColsOnScreen, NrOfTextLines) ;
- WRITELN (' ⁄ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ¬ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒø') ;
- WRITELN (' ≥ NORMAL KEY ≥ CONTROL+KEY ≥') ;
- WRITELN ('⁄ƒƒƒƒƒƒƒƒƒƒƒ≈ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ≈ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ¥') ;
- WRITELN ('≥ ƒ ≥ PREVIOUS CHARACTER ≥ PREVIOUS WORD ≥') ;
- WRITELN ('≥ ƒ ≥ NEXT CHARACTER ≥ NEXT WORD ≥') ;
- WRITELN ('≥ ≥ PREVIOUS LINE ≥ ≥') ;
- WRITELN ('≥ ≥ NEXT LINE ≥ ≥') ;
- WRITELN ('≥ Home ≥ BEGIN OF LINE ≥ BEGIN OF SCREEN ≥') ;
- WRITELN ('≥ End ≥ END OF LINE ≥ END OF SCREEN ≥') ;
- WRITELN ('≥ Page Up ≥ PREVIOUS SCREEN ≥ BEGIN OF TEXT ≥') ;
- WRITELN ('≥ Page Dn ≥ NEXT SCREEN ≥ END OF TEXT ≥') ;
- WRITELN ('¿ƒƒƒƒƒƒƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒŸ') ;
- WRITELN ;
- WRITELN ('⁄ƒƒƒƒƒƒƒƒƒƒƒ¬ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒø') ;
- WRITELN ('≥ Insert ≥ TOGGLE INSERT/OVERWRITE MODE ≥') ;
- WRITELN ('≥ Delete ≥ REMOVE CHARACTER UNDER CURSOR ≥') ;
- WRITELN ('≥ Backspace ≥ REMOVE PREVIOUS CHARACTER ≥') ;
- WRITELN ('≥ Escape ≥ ABORT OPERATION/ERASE MARK ≥') ;
- WRITELN ('¿ƒƒƒƒƒƒƒƒƒƒƒ¡ƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒƒŸ') ;
- Pause ;
- END ; { of if }
- RestoreArea (1, 1, ColsOnScreen, LinesOnScreen, OldDisplayContents) ;
- GOTOXY (OldXpos, OldYpos) ;
- SetCursor (OldCursorType) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Returns a key number, read from a macro if one is running, or from the }
- { keyboard otherwise. The procedure takes care of displaying ASCII tables, }
- { help screens and of storing the number of the key in the macro space }
- { if a macro is being defined. }
- {-----------------------------------------------------------------------------}
-
- FUNCTION GetKeyNr : WORD ;
-
- VAR KeyNr : WORD ;
- Hrs, Mins, Secs, Sec100s, TimePassed : WORD ;
- WsNr : BYTE ;
-
- BEGIN
- IF MacroStackpointer <> Inactive
- THEN
- BEGIN
- CheckEsc ;
- IF EscPressed
- THEN BEGIN
- { macro execution interrupted }
- MacroStackpointer := Inactive ;
- ErrorMessage (18) ;
- KeyNr := EscapeKey ;
- END
- ELSE { get keynumber from macro }
- WITH Config DO
- BEGIN
- Keynr := Macro.Contents [MacroStack [MacroStackpointer].Macronr,
- MacroStack [MacroStackpointer].Index] ;
- REPEAT { set Index to next keynumber in macro sequence }
- INC (MacroStack [MacroStackpointer].Index) ;
- IF MacroStack [MacroStackpointer].Index >
- Macro.LENGTH [MacroStack [MacroStackpointer].Macronr]
- THEN BEGIN
- { macro finished, decrease stackpointer }
- DEC (MacroStackpointer) ;
- END ;
- UNTIL (MacroStackpointer = Inactive) OR
- (MacroStack [MacroStackpointer].Index <=
- Macro.LENGTH [MacroStack [MacroStackpointer].Macronr]) ;
- END ; { of with }
- END
- ELSE BEGIN
- { get keynumber from keyboard }
- REPEAT GETTIME (Hrs, Mins, Secs, Sec100s) ;
- FOR WsNr := 1 TO NrOfWorkspaces DO
- WITH Workspace [WsNr] DO
- BEGIN
- { calculate time since last save of file in Workspace }
- IF LastTimeSaved [1] > Hrs
- THEN TimePassed := 60 * (24 + Hrs - LastTimeSaved [1])
- ELSE TimePassed := 60 * (Hrs - LastTimeSaved [1]) ;
- IF LastTimeSaved [2] > Mins
- THEN DEC (TimePassed, LastTimeSaved [2] - Mins)
- ELSE INC (TimePassed, Mins - LastTimeSaved [2]) ;
- IF LastTimeSaved [3] > Secs
- THEN DEC (TimePassed) ;
- IF (Config.Setup.SaveInterval <> Inactive) AND
- (TimePassed >= Config.Setup.SaveInterval) AND
- ChangesMade AND
- (LENGTH (Name) <> 0)
- THEN SaveFile (Wsnr) ;
- END ; { of with }
- UNTIL KEYPRESSED ;
- REPEAT KeyNr := ReadKeyNr ;
- IF KeyNr = 315 { F1 } THEN DisplayHelp ;
- IF KeyNr = 279 { alt-I } THEN KeyNr := GetKeyFromTable ;
- UNTIL (KeyNr <> 315) AND (KeyNr <> 279) ;
- IF Config.Setup.Keyclick
- THEN BEGIN
- SOUND (440) ;
- DELAY (2) ;
- NOSOUND ;
- END ;
- IF (MacroDefining <> Inactive) AND (KeyNr <> 288 { alt-D })
- THEN BEGIN
- IF Config.Macro.LENGTH [MacroDefining] = MaxMacroLength
- THEN BEGIN
- { macro too long }
- ErrorMessage (6) ;
- MacroDefining := Inactive ;
- END
- ELSE BEGIN
- { add keynumber to macro }
- INC (Config.Macro.LENGTH [MacroDefining]) ;
- Config.Macro.Contents [MacroDefining,
- Config.Macro.LENGTH [MacroDefining]] := KeyNr ;
- END ;
- END ;
- END ; { of if }
- GetKeyNr := KeyNr ;
- MessageRead := TRUE ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Puts a question on the bottom screen line and then waits until the Y, N or }
- { Escape key is pressed. The Y key produces a True result, the N and Escape }
- { a False function result. }
- {-----------------------------------------------------------------------------}
-
- FUNCTION Answer (Question : STRING) : BOOLEAN ;
-
- VAR Key : WORD ;
- OldX, OldY, OldCursorType : BYTE ;
-
- BEGIN
- OldX := WHEREX ;
- OldY := WHEREY ;
- OldCursorType := GetCursor ;
- Message (Question + ' (Y/N) ') ;
- CursorTo (LENGTH (Question) + 8, LinesOnScreen) ;
- SetCursor (Config.Setup.CursorType) ;
- REPEAT Key := GetKeyNr
- UNTIL (Key IN [78, 89, 110, 121]) OR
- (Key = EscapeKey) ;
- Answer := (Key = 89) OR (Key = 121) ;
- EscPressed := (Key = EscapeKey) ;
- CursorTo (OldX, OldY) ;
- SetCursor (OldCursorType) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Displays the Choices string on the bottom screen line, and waits for the }
- { user to make a choice, which is made by pressing a letter key which, }
- { converted to upper case, also occurs in the string. This key is then }
- { returned as the function result. Exit by pressing Escape is also possible. }
- {-----------------------------------------------------------------------------}
-
- FUNCTION Choose (Choices, Prompt : STRING) : CHAR ;
-
- VAR BottomLine : STRING ;
- Key : WORD ;
- Choice : CHAR ;
- Ready : BOOLEAN ;
- P, Col : BYTE ;
- ScrEl : ScreenElement ;
- ScrElPtr : ScreenElementPtr ;
- OldCursorType : BYTE ;
- ShowOnScreen : BOOLEAN ;
-
- BEGIN
- OldCursorType := GetCursor ;
- SetCursor (Inactive) ;
- ScrEl.Attribute := ScreenColorArray [Config.Setup.ScreenColors].StatusCursorAttr ;
- Ready := FALSE ;
- BottomLine := Prompt + Choices ;
- P := LENGTH (Prompt) + 1 ;
- ShowOnScreen := (MacroStackPointer = Inactive) ;
- REPEAT IF ShowOnScreen
- THEN BEGIN
- SetBottomLine (BottomLine) ;
- Col := P ;
- { write selected choice with different screen attribute }
- ScrElPtr := ScreenElementPtr (StatusLinePtr) ;
- INC(ScrElPtr.OFS,2*(Col-1)) ;
- WHILE (BottomLine[Col] <> ' ') AND
- (Col <= LENGTH(BottomLine)) DO
- BEGIN
- ScrEl.Contents := BottomLine [Col] ;
- ScrElPtr.Ref^ := ScrEl ;
- INC (Col) ;
- INC(ScrElPtr.OFS,2) ;
- END ;
- END ;
- Key := GetKeyNr ;
- CASE Key OF
- 331,328 : { left, up }
- BEGIN
- REPEAT IF P = LENGTH (Prompt) + 1
- THEN P := LENGTH(BottomLine)
- ELSE DEC (P) ;
- UNTIL ((BottomLine[P-1] = ' ') AND (BottomLine[P] <> ' '))
- OR (P = LENGTH (Prompt) + 1) ;
- END ;
- 32,333,336 : { space, right, down }
- BEGIN
- REPEAT IF P = LENGTH(BottomLine)
- THEN P := LENGTH (Prompt) + 1
- ELSE INC (P) ;
- UNTIL ((BottomLine[P-1] = ' ') AND (BottomLine[P] <> ' '))
- OR (P = LENGTH (Prompt) + 1) ;
- END ;
- 64..255 : BEGIN
- IF POS (UPCASE (CHR (Key)), Choices) <> 0
- THEN BEGIN
- P := POS (UPCASE (CHR (Key)), Choices) +
- Length (prompt) ;
- Ready := TRUE ;
- END
- ELSE WarningBeep ;
- END ;
- ReturnKey, EscapeKey : Ready := TRUE ;
- END ; { of case }
- UNTIL Ready ;
- EscPressed := (Key = EscapeKey) ;
- IF EscPressed
- THEN Choose := ' '
- ELSE BEGIN
- WHILE (UPCASE(BottomLine[P]) <> BottomLine[P]) DO
- INC(P) ;
- Choose := BottomLine[P] ;
- END ;
- Message ('') ;
- SetCursor (OldCursorType) ;
- END ;
-
- {-----------------------------------------------------------------------------}
- { Displays screen with info about loaded files. }
- { Cursor shape and position and screen contents are saved, and }
- { restored on exit. }
- {-----------------------------------------------------------------------------}
-
- PROCEDURE DisplayInfo ;
-
- VAR OldDisplayContents : ScreenBlockPtr ;
- OldXpos, OldYpos, OldCursorType : BYTE ;
- Counter : WORD ;
-
- BEGIN
- OldXpos := WHEREX ;
- OldYpos := WHEREY ;
- OldCursorType := GetCursor ;
- SaveArea (1, 1, ColsOnScreen, LinesOnScreen, OldDisplayContents) ;
- ClearArea (1, 1, ColsOnScreen, NrOfTextLines) ;
- WRITELN ('EDITOR STATUS') ;
- FOR Counter := 1 TO NrOfWorkSpaces DO
- WITH Workspace [Counter] DO
- BEGIN
- WRITELN ;
- WRITE ('Window ', CHR (64 + Counter) ) ;
- IF Name <> ''
- THEN BEGIN
- GOTOXY (15,WhereY) ;
- WRITELN ('File: ', Name) ;
- END ;
- IF BufferSize > 1
- THEN BEGIN
- GOTOXY (15,WhereY) ;
- WRITELN ('Contains ', BufferSize, ' bytes.') ;
- GOTOXY (15,WhereY) ;
- WRITELN ('Cursor at offset ', Curpos.Index - 1,
- ', character is ASCII ', ORD (Buffer^ [CurPos.Index]),
- '.') ;
- END
- ELSE BEGIN
- GOTOXY (15,WhereY) ;
- WRITELN ('Empty') ;
- END ;
- END ;
- SetCursor (Inactive) ;
- Pause ;
- RestoreArea (1, 1, ColsOnScreen, LinesOnScreen, OldDisplayContents) ;
- GOTOXY (OldXpos, OldYpos) ;
- SetCursor (OldCursorType) ;
- END ;
-
- {-----------------------------------------------------------------------------}
-
- END.